home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / soundu / dilaudid.zip / NEW / PLAY2.BAS < prev    next >
BASIC Source File  |  1994-03-02  |  7KB  |  249 lines
  1. DECLARE FUNCTION getoct% (note$)
  2. DECLARE SUB doplay (dat%)
  3. DECLARE SUB d1 ()
  4. DECLARE SUB d2 ()
  5. DECLARE SUB playnote (note$, oct%)
  6. DECLARE SUB stopplay ()
  7. DECLARE SUB setoptions (am%, vibrato%, sustain%, harmonic%)
  8. DECLARE SUB setlevel (level%)
  9. DECLARE SUB setad (attack%, decay%)
  10. DECLARE SUB setsr (sustain%, release%)
  11. DECLARE SUB setwave (wavetype%)
  12. DECLARE SUB delay ()
  13. DEFINT A-Z
  14. COMMON SHARED curvoice, curoctave, curlength, deflength, curtempo
  15.  
  16. curtempo = 120
  17.  
  18. file$ = COMMAND$
  19. IF file$ = "" THEN
  20.         PRINT "play FILENAME"
  21.         END
  22. END IF
  23.  
  24. deflength = 16  'quarter note default
  25. curlength = 16
  26.  
  27. RANDOMIZE TIMER
  28. FOR curvoice = 0 TO 10
  29.     setoptions 0, 0, 1, 1
  30.     setlevel 63
  31.     setad 8, 1
  32.     setsr 2, 15
  33.     setwave curvoice MOD 4
  34.     stopplay
  35. NEXT
  36.  
  37.  
  38. curvoice = 0
  39. setlevel 20
  40.  
  41. CLS
  42.  
  43. OPEN file$ FOR INPUT AS #1
  44.  
  45. DO
  46.     LINE INPUT #1, x$
  47.     PRINT ">"; x$;
  48.     FOR curvoice = 0 TO 10
  49.         note$ = MID$(x$, (curvoice * 3) + 1, 3)
  50.         SELECT CASE note$
  51.             CASE "   "  'nothing
  52.             CASE "***"  'stop
  53.                 stopplay
  54.             CASE ELSE   'new note X: X" X' X x x' x" x: x; x= x*
  55.                 stopplay
  56.                 note$ = LTRIM$(RTRIM$(note$))
  57.                 oct = getoct(note$)
  58.                 playnote note$, oct
  59.         END SELECT
  60.     NEXT
  61.     PRINT
  62.     delay
  63. LOOP UNTIL EOF(1) OR INKEY$ <> ""
  64.  
  65. FOR curvoice = 0 TO 10
  66.     setad 15, 15
  67. NEXT
  68.  
  69. CLOSE
  70.  
  71. SUB d1
  72.         FOR r = 1 TO 6: x = INP(&H388): NEXT
  73. END SUB
  74.  
  75. SUB d2
  76.         FOR r = 1 TO 35: x = INP(&H388): NEXT
  77. END SUB
  78.  
  79. SUB delay
  80.         x# = (1 / curlength) * (60 / curtempo)
  81.         xx# = TIMER + x#
  82.         DO UNTIL TIMER > xx#: LOOP
  83. END SUB
  84.  
  85. SUB doplay (dat)
  86.         curvoice = 0
  87.         curlength = 8
  88.         curoctave = dat \ 25
  89.         x$ = "defgabccccc"
  90.         n$ = MID$(x$, ((dat MOD 25) \ 4) + 1, 1)
  91.         stopplay
  92.         playnote n$, curoctave
  93.         PRINT n$ + "/o" + LTRIM$(RTRIM$(STR$(curoctave))) + " ";
  94.         delay
  95.  
  96. END SUB
  97.  
  98. FUNCTION getoct (note$)
  99.     ' X" X' X x x' x" x: x; x= x*
  100.     no = 1
  101.     IF ASC(MID$(note$, 1, 1)) < 72 THEN 'ucase
  102.         SELECT CASE RIGHT$(note$, 1)
  103.             CASE ":"
  104.                 oct = 0
  105.             CASE CHR$(34)
  106.                 oct = 1
  107.             CASE "'"
  108.                 oct = 2
  109.             CASE ELSE
  110.                 oct = 3
  111.                 no = 0
  112.         END SELECT
  113.     ELSE
  114.         SELECT CASE RIGHT$(note$, 1)
  115.             CASE "'"
  116.                 oct = 5
  117.             CASE CHR$(34)
  118.                 oct = 6
  119.             CASE ":"
  120.                 oct = 7
  121.             CASE ";"
  122.                 oct = 8
  123.             CASE "="
  124.                 oct = 9
  125.             CASE "*"
  126.                 oct = 10
  127.             CASE ELSE
  128.                 oct = 4
  129.                 no = 0
  130.         END SELECT
  131.     END IF
  132.     IF no = 1 THEN note$ = MID$(note$, 1, LEN(note$) - 1)
  133.     getoct = oct
  134. END FUNCTION
  135.  
  136. SUB playnote (note$, oct)
  137. SELECT CASE LCASE$(note$)
  138.         CASE "c#", "c+", "d-"
  139.                 msb = &H1: lsb = &H6B
  140.         CASE "d"
  141.                 msb = &H1: lsb = &H81
  142.         CASE "d#", "d+", "e-"
  143.                 msb = &H1: lsb = &H98
  144.         CASE "e"
  145.                 msb = &H1: lsb = &HB0
  146.         CASE "f"
  147.                 msb = &H1: lsb = &HCA
  148.         CASE "f#", "f+", "g-"
  149.                 msb = &H1: lsb = &HE5
  150.         CASE "g"
  151.                 msb = &H2: lsb = &H2
  152.         CASE "g#", "g+", "a-"
  153.                 msb = &H2: lsb = &H20
  154.         CASE "a"
  155.                 msb = &H2: lsb = &H41
  156.         CASE "a#", "a+", "b-"
  157.                 msb = &H2: lsb = &H63
  158.         CASE "b"
  159.                 msb = &H2: lsb = &H87
  160.         CASE "c"
  161.                 msb = &H2: lsb = &HAE
  162.                 oct = oct - 1
  163.         CASE ELSE
  164.                 PRINT "ERR[" + note$ + "]";
  165. END SELECT
  166.  
  167.         OUT &H388, &HA0 + curvoice: d1
  168.         OUT &H389, lsb: d2
  169.         OUT &H388, &HA3 + curvoice: d1
  170.         OUT &H389, lsb: d2
  171.  
  172.         OUT &H388, &HB0 + curvoice: d1
  173.         OUT &H389, msb + (oct * 4) + 32: d2
  174.         OUT &H388, &HB3 + curvoice: d1
  175.         OUT &H389, msb + (oct * 4) + 32: d2
  176.  
  177. END SUB
  178.  
  179. SUB setad (attack, decay)
  180.         OUT &H388, &H60 + curvoice: d1
  181.         OUT &H389, (attack * 16) + decay: d2
  182.         OUT &H388, &H63 + curvoice: d1
  183.         OUT &H389, (attack * 16) + decay: d2
  184. END SUB
  185.  
  186. SUB setlevel (level)
  187.         OUT &H388, &H40 + curvoice: d1
  188.         OUT &H389, (63 - level): d2
  189.         OUT &H388, &H43 + curvoice: d1
  190.         OUT &H389, (63 - level): d2
  191. END SUB
  192.  
  193. SUB setoptions (am, vibrato, sustain, harmonic)
  194.         temp = 0
  195.         IF am THEN temp = 128
  196.         IF vibrato THEN temp = temp + 64
  197.         IF sustain THEN temp = temp + 32
  198.         '       harmonic options:
  199.         '            0 - one octave below
  200.         '            1 - at the voice's specified frequency
  201.         '            2 - one octave above
  202.         '            3 - an octave and a fifth above
  203.         '            4 - two octaves above
  204.         '            5 - two octaves and a major third above
  205.         '            6 - two octaves and a fifth above
  206.         '            7 - two octaves and a minor seventh above
  207.         '            8 - three octaves above
  208.         '            9 - three octaves and a major second above
  209.         '           10 - three octaves and a major third above
  210.         '           11 -  "       "     "  "   "     "     "
  211.         '           12 - three octaves and a fifth above
  212.         '           13 -   "      "     "  "   "     "
  213.         '           14 - three octaves and a major seventh above
  214.         '           15 -   "      "     "  "   "      "      "
  215.         temp = temp + harmonic
  216.         OUT &H388, &H20 + curvoice: d1
  217.         OUT &H389, temp: d2
  218.         OUT &H388, &H23 + curvoice: d1
  219.         OUT &H389, temp: d2
  220. END SUB
  221.  
  222. SUB setsr (sustain, release)
  223.         OUT &H388, &H80 + curvoice: d1
  224.         OUT &H389, ((15 - sustain) * 16) + release: d2
  225.         OUT &H388, &H83 + curvoice: d1
  226.         OUT &H389, ((15 - sustain) * 16) + release: d2
  227. END SUB
  228.  
  229. SUB setwave (wavetype)
  230.         OUT &H388, &HE0 + curvoice: d1
  231.         '   ___              ___            ___    ___       _      _
  232.         '  /   \            /   \          /   \  /   \     / |    / |
  233.         ' /_____\_______   /_____\_____   /_____\/_____\   /__|___/__|___
  234.         '        \     /
  235.         '         \___/
  236.         '     -0-             -1-              -2-             -3-
  237.         OUT &H389, wavetype: d2
  238.         OUT &H388, &HE3 + curvoice: d1
  239.         OUT &H389, wavetype: d2
  240. END SUB
  241.  
  242. SUB stopplay
  243.         OUT &H388, &HB0 + curvoice: d1
  244.         OUT &H389, 0: d2
  245.         OUT &H388, &HB3 + curvoice: d1
  246.         OUT &H389, 0: d2
  247. END SUB
  248.  
  249.